home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / GW AdaEd 1.4.2 / GWAdaDemos / NYUDemos / PHIL.ADA < prev    next >
Encoding:
Text File  |  1993-01-31  |  4.5 KB  |  184 lines  |  [TEXT/GADA]
  1. ----------------------------------------------------------------------
  2. --
  3. --              The Dining Philosophers' Problem
  4. --
  5. --                      written by
  6. --
  7. --                   Edmond Schonberg
  8. --                        and
  9. --                    Gerry Fisher
  10. --
  11. --                      Ada Project
  12. --                   Courant Institute
  13. --                  New York University
  14. --                   251 Mercer Street
  15. --                New York, New York  10012
  16. --
  17. -----------------------------------------------------------------------
  18.  
  19. with TEXT_IO; use TEXT_IO; 
  20. procedure DINING_PHILOSOPHERS is
  21.     
  22.     type PHILOSOPHER is (Descartes, Hegel, Turing, Plato, Sartre);
  23.  
  24.     meals: constant array(PHILOSOPHER) of INTEGER := (3,2,2,2,3);
  25.  
  26.     Message1: constant array(PHILOSOPHER) of STRING(1 .. 30)  :=
  27.         ("I eat: therefore I am         ",
  28.          "Hegel synthesizes             ",
  29.          "Turing shifts                 ",
  30.          "Plato eats the ideal spaghetti",
  31.          "Sartre gorges                 "
  32.      );
  33.  
  34.     Message2: constant array(PHILOSOPHER) of STRING(1 .. 30)  :=
  35.         ("Descartes cogitates           ",
  36.          "Hegel's pure spirit at work   ",
  37.          "Turing machinates             ",
  38.          "Plato watches the shadows     ",
  39.          "Sartre eats nothing           "
  40.      );
  41.  
  42.     Message3: constant array(PHILOSOPHER) of STRING(1 .. 30)  :=
  43.         ("Descartes concludes           ",
  44.          "The owl of Minerva is stuffed ",
  45.          "Turing halts                  ",
  46.          "Plato retreats                ",
  47.          "Sartre is nauseated           "
  48.      );
  49.  
  50.     task type DINING is
  51.     entry WHO_AM_I(p: PHILOSOPHER);
  52.     end DINING;
  53.  
  54.     task TABLE_MANAGER is
  55.         entry EAT(PHILOSOPHER);
  56.         entry REST(p: PHILOSOPHER);
  57.     entry FAST_RELIEF(p: PHILOSOPHER);
  58.     end TABLE_MANAGER;
  59.  
  60.     task body DINING is separate;
  61.  
  62.     task body TABLE_MANAGER is separate;
  63.  
  64. begin
  65.  
  66.     declare
  67.     PHILS: array(PHILOSOPHER) of DINING;
  68.     begin
  69.     for philo in PHILOSOPHER
  70.     loop
  71.         PHILS(philo).WHO_AM_I(philo);
  72.     end loop;
  73.     end;
  74.  
  75.     put_line("Closing time ...");
  76.  
  77. end DINING_PHILOSOPHERS;
  78.  
  79. -----------------------------------------------------------------------
  80.  
  81. separate(DINING_PHILOSOPHERS)
  82. task body DINING is
  83.  
  84.     philo: PHILOSOPHER;
  85.  
  86. begin
  87.  
  88.     accept WHO_AM_I(p: PHILOSOPHER) do
  89.     philo := p;
  90.     end WHO_AM_I;
  91.  
  92.     for n in 1 .. meals(philo) 
  93.     loop
  94.         TABLE_MANAGER.EAT(philo);
  95.         delay 1.0;
  96.         TABLE_MANAGER.REST(philo);
  97.     delay 0.5;
  98.     end loop;
  99.  
  100.     TABLE_MANAGER.FAST_RELIEF(philo);
  101.  
  102. end DINING;
  103.  
  104.  
  105. ------------------------------------------------------------------------
  106.  
  107. separate(DINING_PHILOSOPHERS) 
  108. task body TABLE_MANAGER is
  109.  
  110.     type AVAIL is 
  111.     record 
  112.         LEFT, RIGHT: BOOLEAN; 
  113.     end record;
  114.  
  115.     FORKS: array(PHILOSOPHER) of AVAIL := 
  116.         (PHILOSOPHER'FIRST..PHILOSOPHER'LAST => (TRUE, TRUE));
  117.     type ACTION is (seize,release);
  118.     numphil: constant INTEGER := 5;
  119.     TWO: constant AVAIL := (TRUE,TRUE);
  120.  
  121.     procedure fork_action(p: PHILOSOPHER; a: ACTION) is separate;
  122.  
  123. begin
  124.  
  125.     loop
  126.         select
  127.             when FORKS(Descartes) = TWO => 
  128.         accept EAT(Descartes);
  129.                 fork_action(Descartes, seize);
  130.         put_line(Message1(Descartes));
  131.  
  132.     or  when FORKS(Hegel) = TWO => 
  133.         accept EAT(Hegel);
  134.                 fork_action(Hegel, seize);
  135.         put_line(Message1(Hegel));
  136.  
  137.         or  when FORKS(Turing) = TWO => 
  138.         accept EAT(Turing);
  139.                 fork_action(Turing, seize);
  140.         put_line(Message1(Turing));
  141.  
  142.         or  when FORKS(Plato) = TWO => 
  143.         accept EAT(Plato);
  144.                 fork_action(Plato, seize);
  145.         put_line(Message1(Plato));
  146.  
  147.         or  when FORKS(Sartre) = TWO => 
  148.         accept EAT(Sartre);
  149.                 fork_action(Sartre, seize);
  150.         put_line(Message1(Sartre));
  151.  
  152.         or      
  153.         accept REST(p: PHILOSOPHER) do
  154.                     fork_action(p, release);
  155.                 put_line(Message2(p));
  156.                 end REST;
  157.  
  158.     or      
  159.         accept FAST_RELIEF(p: PHILOSOPHER) do
  160.             put_line(Message3(p));
  161.             end FAST_RELIEF;
  162.         or
  163.             terminate;
  164.  
  165.         end select ;
  166.  
  167.     end loop ;
  168.  
  169. end TABLE_MANAGER ;
  170.  
  171.  
  172. ----------------------------------------------------------------------
  173.  
  174. separate(DINING_PHILOSOPHERS.TABLE_MANAGER)
  175. procedure fork_action(p: PHILOSOPHER; a: ACTION) is
  176.     pp: PHILOSOPHER;
  177.     v: array(ACTION) of BOOLEAN := (FALSE, TRUE);
  178. begin
  179.     pp := PHILOSOPHER'VAL((PHILOSOPHER'POS(p) + 1) mod numphil);
  180.     FORKS(pp).LEFT := v(a);
  181.     pp := PHILOSOPHER'VAL((PHILOSOPHER'POS(p) + 4) mod numphil);
  182.     FORKS(pp).RIGHT := v(a);
  183. end fork_action;
  184.